;;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-User; Base: 10 -*-
;;; @(#)$Id: //proj/evcl3/mainline/testcase/tc-12-cl-bignum.lisp#1 $
(in-package :tc-user)

(deftest cl-12-00-201 ()
  (labels ((fact (n) (if (zerop n) 1 (* n (fact (1- n))))))
    (values (fact 10) (fact 15) (fact 20)) )
  (values 3628800 1307674368000 2432902008176640000) )


;;; 12.2.19 floor, ceiling, truncate, round
#+nil
(deftest cl-12-19-201 ()
    (labels (
      (test-it (fn x y)
         (setq x (* x (expt 10 5)))
         (setq y (* y (expt 10 5)))

         (let (iq ir fq fr)
           (multiple-value-setq (iq ir) (funcall fn x y))

           (multiple-value-setq (fq fr)
              (funcall fn (float x 0d0) (float y 0d0)) )

           (unless (and (= iq fq) (= ir fr))
             (list (list fn x y)) )) )

      (test-them (fn)
        (loop for xy in '((  90  100  2  5)
                          (  90  100 -5 -2)
                          (-100   90  2  5)
                          (-100  -90 -5 -2) )
          nconc
            (loop for x from (first xy) to (second xy)
              nconc
                (loop for y from (third xy) to (fourth xy)
                  nconc (test-it fn x y) ))) )
      )
      ;;
      (loop for fn in '(ceiling floor round truncate)
            collect (test-them fn) ) )
  (nil nil nil nil) )

;;;; 12.2.24 *
(deftest cl-12-24-201 () (* (ash +1 32) (ash +1 32))   +18446744073709551616)
(deftest cl-12-24-202 () (* (ash +1 32) (ash -1 32))   -18446744073709551616)
(deftest cl-12-24-203 () (* (ash -1 32) (ash +1 32))   -18446744073709551616)
(deftest cl-12-24-204 () (* (ash -1 32) (ash -1 32))   +18446744073709551616)
(deftest cl-12-24-205 () (* (ash +1 64) (ash +1 64))   +340282366920938463463374607431768211456)
(deftest cl-12-24-206 () (* (ash +1 64) (ash -1 64))   -340282366920938463463374607431768211456)
(deftest cl-12-24-207 () (* (ash -1 64) (ash +1 64))   -340282366920938463463374607431768211456)
(deftest cl-12-24-208 () (* (ash -1 64) (ash -1 64))   +340282366920938463463374607431768211456)

(deftest cl-12-24-209 () (* (ash +1 96) (ash +1 96))   +6277101735386680763835789423207666416102355444464034512896)
(deftest cl-12-24-210 () (* (ash +1 96) (ash -1 96))   -6277101735386680763835789423207666416102355444464034512896)
(deftest cl-12-24-201 () (* (ash -1 96) (ash +1 96))   -6277101735386680763835789423207666416102355444464034512896)
(deftest cl-12-24-201 () (* (ash -1 96) (ash -1 96))   +6277101735386680763835789423207666416102355444464034512896)

(deftest cl-12-24-211 () (* (+ (expt 10 10)) (+ (expt 10 10))) +100000000000000000000)
(deftest cl-12-24-212 () (* (+ (expt 10 10)) (- (expt 10 10))) -100000000000000000000)
(deftest cl-12-24-213 () (* (- (expt 10 10)) (+ (expt 10 10))) -100000000000000000000)
(deftest cl-12-24-214 () (* (- (expt 10 10)) (- (expt 10 10))) +100000000000000000000)


;;;; 12.2.25 +
(deftest cl-12-25-201 ()
    (+ most-positive-fixnum 1)
    #+32bit 536870912
    #+64bit 1152921504606846976 )

(deftest cl-12-25-202 () (+ (ash -1 127) (ash -1 127)) -340282366920938463463374607431768211456)
(deftest cl-12-25-203 () (+ (ash -1 127) (ash 1 127)) 0)
(deftest cl-12-25-204 () (+ (ash -1 128) (ash -1 127)) -510423550381407695195061911147652317184)
(deftest cl-12-25-205 () (+ (ash -1 128) (ash -1 128)) -680564733841876926926749214863536422912)
(deftest cl-12-25-206 () (+ (ash -1 128) (ash 1 127)) -170141183460469231731687303715884105728)
(deftest cl-12-25-207 () (+ (ash -1 128) (ash 1 128)) 0)
(deftest cl-12-25-208 () (+ (ash -1 129) (ash -1 129)) -1361129467683753853853498429727072845824)
(deftest cl-12-25-209 () (+ (ash -1 129) (ash 1 129)) 0)
(deftest cl-12-25-210 () (+ (ash -1 31) (ash -1 31)) -4294967296)
(deftest cl-12-25-211 () (+ (ash -1 31) (ash 1 31)) 0)
(deftest cl-12-25-212 () (+ (ash -1 32) (ash -1 31)) -6442450944)
(deftest cl-12-25-213 () (+ (ash -1 32) (ash -1 32)) -8589934592)
(deftest cl-12-25-214 () (+ (ash -1 32) (ash 1 31)) -2147483648)
(deftest cl-12-25-215 () (+ (ash -1 32) (ash 1 32)) 0)
(deftest cl-12-25-216 () (+ (ash -1 33) (ash -1 33)) -17179869184)
(deftest cl-12-25-217 () (+ (ash -1 33) (ash 1 33)) 0)
(deftest cl-12-25-218 () (+ (ash -1 63) (ash -1 63)) -18446744073709551616)
(deftest cl-12-25-219 () (+ (ash -1 63) (ash 1 63)) 0)
(deftest cl-12-25-220 () (+ (ash -1 64) (ash -1 63)) -27670116110564327424)
(deftest cl-12-25-221 () (+ (ash -1 64) (ash -1 64)) -36893488147419103232)
(deftest cl-12-25-222 () (+ (ash -1 64) (ash 1 63)) -9223372036854775808)
(deftest cl-12-25-223 () (+ (ash -1 64) (ash 1 64)) 0)
(deftest cl-12-25-224 () (+ (ash -1 65) (ash -1 65)) -73786976294838206464)
(deftest cl-12-25-225 () (+ (ash -1 65) (ash 1 65)) 0)
(deftest cl-12-25-226 () (+ (ash -1 95) (ash -1 95)) -79228162514264337593543950336)
(deftest cl-12-25-227 () (+ (ash -1 95) (ash 1 95)) 0)
(deftest cl-12-25-228 () (+ (ash -1 96) (ash -1 95)) -118842243771396506390315925504)
(deftest cl-12-25-229 () (+ (ash -1 96) (ash -1 96)) -158456325028528675187087900672)
(deftest cl-12-25-230 () (+ (ash -1 96) (ash 1 95)) -39614081257132168796771975168)
(deftest cl-12-25-231 () (+ (ash -1 96) (ash 1 96)) 0)
(deftest cl-12-25-232 () (+ (ash -1 97) (ash -1 97)) -316912650057057350374175801344)
(deftest cl-12-25-233 () (+ (ash -1 97) (ash 1 97)) 0)
(deftest cl-12-25-234 () (+ (ash 1 127) (ash -1 127)) 0)
(deftest cl-12-25-235 () (+ (ash 1 127) (ash 1 127)) 340282366920938463463374607431768211456)
(deftest cl-12-25-236 () (+ (ash 1 128) (ash -1 127)) 170141183460469231731687303715884105728)
(deftest cl-12-25-237 () (+ (ash 1 128) (ash -1 128)) 0)
(deftest cl-12-25-238 () (+ (ash 1 128) (ash 1 127)) 510423550381407695195061911147652317184)
(deftest cl-12-25-239 () (+ (ash 1 128) (ash 1 128)) 680564733841876926926749214863536422912)
(deftest cl-12-25-240 () (+ (ash 1 129) (ash -1 129)) 0)
(deftest cl-12-25-241 () (+ (ash 1 129) (ash 1 129)) 1361129467683753853853498429727072845824)
(deftest cl-12-25-242 () (+ (ash 1 31) (ash -1 31)) 0)
(deftest cl-12-25-243 () (+ (ash 1 31) (ash 1 31)) 4294967296)
(deftest cl-12-25-244 () (+ (ash 1 32) (ash -1 31)) 2147483648)
(deftest cl-12-25-245 () (+ (ash 1 32) (ash -1 32)) 0)
(deftest cl-12-25-246 () (+ (ash 1 32) (ash 1 31)) 6442450944)
(deftest cl-12-25-247 () (+ (ash 1 32) (ash 1 32)) 8589934592)
(deftest cl-12-25-248 () (+ (ash 1 33) (ash -1 33)) 0)
(deftest cl-12-25-249 () (+ (ash 1 33) (ash 1 33)) 17179869184)
(deftest cl-12-25-250 () (+ (ash 1 63) (ash -1 63)) 0)
(deftest cl-12-25-251 () (+ (ash 1 63) (ash 1 63)) 18446744073709551616)
(deftest cl-12-25-252 () (+ (ash 1 64) (ash -1 63)) 9223372036854775808)
(deftest cl-12-25-253 () (+ (ash 1 64) (ash -1 64)) 0)
(deftest cl-12-25-254 () (+ (ash 1 64) (ash 1 63)) 27670116110564327424)
(deftest cl-12-25-255 () (+ (ash 1 64) (ash 1 64)) 36893488147419103232)
(deftest cl-12-25-256 () (+ (ash 1 65) (ash -1 65)) 0)
(deftest cl-12-25-257 () (+ (ash 1 65) (ash 1 65)) 73786976294838206464)
(deftest cl-12-25-258 () (+ (ash 1 95) (ash -1 95)) 0)
(deftest cl-12-25-259 () (+ (ash 1 95) (ash 1 95)) 79228162514264337593543950336)
(deftest cl-12-25-260 () (+ (ash 1 96) (ash -1 95)) 39614081257132168796771975168)
(deftest cl-12-25-261 () (+ (ash 1 96) (ash -1 96)) 0)
(deftest cl-12-25-262 () (+ (ash 1 96) (ash 1 95)) 118842243771396506390315925504)
(deftest cl-12-25-263 () (+ (ash 1 96) (ash 1 96)) 158456325028528675187087900672)
(deftest cl-12-25-264 () (+ (ash 1 97) (ash -1 97)) 0)
(deftest cl-12-25-265 () (+ (ash 1 97) (ash 1 97)) 316912650057057350374175801344)

;;;; 12.2.26 -
(deftest cl-12-26-201 ()
    (- most-negative-fixnum 1)
    #+32bit -536870913
    #+64bit -1152921504606846977 )

(deftest cl-12-26-202 () (- (ash -1 127) (ash -1 127)) 0)
(deftest cl-12-26-203 () (- (ash -1 127) (ash 1 127)) -340282366920938463463374607431768211456)
(deftest cl-12-26-204 () (- (ash -1 128) (ash -1 127)) -170141183460469231731687303715884105728)
(deftest cl-12-26-205 () (- (ash -1 128) (ash -1 128)) 0)
(deftest cl-12-26-206 () (- (ash -1 128) (ash 1 127)) -510423550381407695195061911147652317184)
(deftest cl-12-26-207 () (- (ash -1 128) (ash 1 128)) -680564733841876926926749214863536422912)
(deftest cl-12-26-208 () (- (ash -1 129) (ash -1 129)) 0)
(deftest cl-12-26-209 () (- (ash -1 129) (ash 1 129)) -1361129467683753853853498429727072845824)
(deftest cl-12-26-210 () (- (ash -1 31) (ash -1 31)) 0)
(deftest cl-12-26-211 () (- (ash -1 31) (ash 1 31)) -4294967296)
(deftest cl-12-26-212 () (- (ash -1 32) (ash -1 31)) -2147483648)
(deftest cl-12-26-213 () (- (ash -1 32) (ash -1 32)) 0)
(deftest cl-12-26-214 () (- (ash -1 32) (ash 1 31)) -6442450944)
(deftest cl-12-26-215 () (- (ash -1 32) (ash 1 32)) -8589934592)
(deftest cl-12-26-216 () (- (ash -1 33) (ash -1 33)) 0)
(deftest cl-12-26-217 () (- (ash -1 33) (ash 1 33)) -17179869184)
(deftest cl-12-26-218 () (- (ash -1 63) (ash -1 63)) 0)
(deftest cl-12-26-219 () (- (ash -1 63) (ash 1 63)) -18446744073709551616)
(deftest cl-12-26-220 () (- (ash -1 64) (ash -1 63)) -9223372036854775808)
(deftest cl-12-26-221 () (- (ash -1 64) (ash -1 64)) 0)
(deftest cl-12-26-222 () (- (ash -1 64) (ash 1 63)) -27670116110564327424)
(deftest cl-12-26-223 () (- (ash -1 64) (ash 1 64)) -36893488147419103232)
(deftest cl-12-26-224 () (- (ash -1 65) (ash -1 65)) 0)
(deftest cl-12-26-225 () (- (ash -1 65) (ash 1 65)) -73786976294838206464)
(deftest cl-12-26-226 () (- (ash -1 95) (ash -1 95)) 0)
(deftest cl-12-26-227 () (- (ash -1 95) (ash 1 95)) -79228162514264337593543950336)
(deftest cl-12-26-228 () (- (ash -1 96) (ash -1 95)) -39614081257132168796771975168)
(deftest cl-12-26-229 () (- (ash -1 96) (ash -1 96)) 0)
(deftest cl-12-26-230 () (- (ash -1 96) (ash 1 95)) -118842243771396506390315925504)
(deftest cl-12-26-231 () (- (ash -1 96) (ash 1 96)) -158456325028528675187087900672)
(deftest cl-12-26-232 () (- (ash -1 97) (ash -1 97)) 0)
(deftest cl-12-26-233 () (- (ash -1 97) (ash 1 97)) -316912650057057350374175801344)
(deftest cl-12-26-234 () (- (ash 1 127) (ash -1 127)) 340282366920938463463374607431768211456)
(deftest cl-12-26-235 () (- (ash 1 127) (ash 1 127)) 0)
(deftest cl-12-26-236 () (- (ash 1 128) (ash -1 127)) 510423550381407695195061911147652317184)
(deftest cl-12-26-237 () (- (ash 1 128) (ash -1 128)) 680564733841876926926749214863536422912)
(deftest cl-12-26-238 () (- (ash 1 128) (ash 1 127)) 170141183460469231731687303715884105728)
(deftest cl-12-26-239 () (- (ash 1 128) (ash 1 128)) 0)
(deftest cl-12-26-240 () (- (ash 1 129) (ash -1 129)) 1361129467683753853853498429727072845824)
(deftest cl-12-26-241 () (- (ash 1 129) (ash 1 129)) 0)
(deftest cl-12-26-242 () (- (ash 1 31) (ash -1 31)) 4294967296)
(deftest cl-12-26-243 () (- (ash 1 31) (ash 1 31)) 0)
(deftest cl-12-26-244 () (- (ash 1 32) (ash -1 31)) 6442450944)
(deftest cl-12-26-245 () (- (ash 1 32) (ash -1 32)) 8589934592)
(deftest cl-12-26-246 () (- (ash 1 32) (ash 1 31)) 2147483648)
(deftest cl-12-26-247 () (- (ash 1 32) (ash 1 32)) 0)
(deftest cl-12-26-248 () (- (ash 1 33) (ash -1 33)) 17179869184)
(deftest cl-12-26-249 () (- (ash 1 33) (ash 1 33)) 0)
(deftest cl-12-26-250 () (- (ash 1 63) (ash -1 63)) 18446744073709551616)
(deftest cl-12-26-251 () (- (ash 1 63) (ash 1 63)) 0)
(deftest cl-12-26-252 () (- (ash 1 64) (ash -1 63)) 27670116110564327424)
(deftest cl-12-26-253 () (- (ash 1 64) (ash -1 64)) 36893488147419103232)
(deftest cl-12-26-254 () (- (ash 1 64) (ash 1 63)) 9223372036854775808)
(deftest cl-12-26-255 () (- (ash 1 64) (ash 1 64)) 0)
(deftest cl-12-26-256 () (- (ash 1 65) (ash -1 65)) 73786976294838206464)
(deftest cl-12-26-257 () (- (ash 1 65) (ash 1 65)) 0)
(deftest cl-12-26-258 () (- (ash 1 95) (ash -1 95)) 79228162514264337593543950336)
(deftest cl-12-26-259 () (- (ash 1 95) (ash 1 95)) 0)
(deftest cl-12-26-260 () (- (ash 1 96) (ash -1 95)) 118842243771396506390315925504)
(deftest cl-12-26-261 () (- (ash 1 96) (ash -1 96)) 158456325028528675187087900672)
(deftest cl-12-26-262 () (- (ash 1 96) (ash 1 95)) 39614081257132168796771975168)
(deftest cl-12-26-263 () (- (ash 1 96) (ash 1 96)) 0)
(deftest cl-12-26-264 () (- (ash 1 97) (ash -1 97)) 316912650057057350374175801344)
(deftest cl-12-26-265 () (- (ash 1 97) (ash 1 97)) 0)

;;;; 12.2.27 /

;;; Note: For D6 testing (B=32), we can use following
;;;       (from 4500/501 where B=10):
;;;  (setq u #x7FFFFFFF800000000000000000000000)
;;;          ; 170141183420855150474555134919112130560
;;;  (setq v #x800000000000000000000001)
;;;          ; 39614081257132168796771975169
;;;  (/ u v)
;;;      56713727806951716824851711639704043520/13204693752377389598923991723
;;;      2AAA AAAA 8000 00000 000 0000 0000 0000/2AAA AAAA AAAA AAAA AAAA AAAB
(deftest cl-12-27-201 ()
    (/ #x7FFFFFFF800000000000000000000000 #x800000000000000000000001)
    56713727806951716824851711639704043520/13204693752377389598923991723 )

;; D3 Calculate qhat
;; overflow in (u[j+n] * base + u[j+n-1]) / v[n-1]
;; (values #xFFFFFFFE #x2AAAAAAAAAAAAAAA55555556)
(deftest cl-12-27-202 ()
 (truncate 56713727806951716824851711639704043520
           13204693752377389598923991723 )
 (values 4294967294 13204693752377389597492335958) )


;; Test D6 for 64-bit bigit. 32-bit bigit doesn't go D6 in this case.
;;      76532107653210      76532107653210
;;  [0] 7FFFFFFFFFFFFFFF    80000000000000
;;  [1] 8000000000000000    00000000000000
;;  [2] 0000000000000000    00000000000001
;;  [3] 0000000000000000
;; #x2AAAAAAAAAAAAAAA800000000000000000000000000000000000000000000000/2AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB
(deftest cl-12-27-203 ()
    (/ #x7FFFFFFFFFFFFFFF800000000000000000000000000000000000000000000000
       #x800000000000000000000000000000000000000000000001 )
    19298681539552699236215647212216871181572365873738816270559204760574849187840/1046183622564446793972631570534611069350392574077339085483 )

;; Another test case for D6 of 32-bit
(deftest cl-12-27-204 ()
  (truncate  #xFFFFFFFF800000000000000000000000 #x800000004000000080000000)
  (values #x1FFFFFFFD #x7FFFFFFFC000000180000000) )

;; Skip leading zero
(deftest cl-12-27-205 ()
  (truncate #x7FFFFFFF80000000 #x80000000)
  (values #xFFFFFFFF 0) )

;;; 12.2.36 mod (floor), rem (truncate)
(deftest cl-12-36-201 ()
  (list (rem +50 +6)     ; P/P=>P,P
        (rem -50 +6)     ; N/P=>N,N
        (rem +50 -6)     ; P/N=>P,N
        (rem -50 -6) )   ; N/N=>P,N
  (2 -2 2 -2) )

;;; 12.2.56 ash
(deftest cl-12-56-201 () (ash 1 30) #x40000000)
(deftest cl-12-56-202 () (ash 1 40) #x10000000000)
(deftest cl-12-56-203 () (ash 1 50) #x4000000000000)
(deftest cl-12-56-204 () (ash 1 60) #x1000000000000000)
(deftest cl-12-56-205 () (ash 1 70) #x400000000000000000)
(deftest cl-12-56-206 () (ash 1 80) #x100000000000000000000)
(deftest cl-12-56-207 () (ash 1 90) #x40000000000000000000000)
(deftest cl-12-56-208 () (ash 1 100) #x10000000000000000000000000)
(deftest cl-12-56-209 () (ash 1 110) #x4000000000000000000000000000)
(deftest cl-12-56-210 () (ash 1 120) #x1000000000000000000000000000000)
(deftest cl-12-56-211 () (ash 1 130) #x400000000000000000000000000000000)
(deftest cl-12-56-212 () (ash 1 140) #x100000000000000000000000000000000000)
(deftest cl-12-56-213 () (ash 1 150) #x40000000000000000000000000000000000000)
(deftest cl-12-56-214 () (ash 1 160) #x10000000000000000000000000000000000000000)
(deftest cl-12-56-215 () (ash 1 170) #x4000000000000000000000000000000000000000000)
(deftest cl-12-56-216 () (ash 1 180) #x1000000000000000000000000000000000000000000000)
(deftest cl-12-56-217 () (ash 1 190) #x400000000000000000000000000000000000000000000000)
(deftest cl-12-56-218 () (ash 1 200) #x100000000000000000000000000000000000000000000000000)

(deftest cl-12-56-220 () (ash -1 30) #x-40000000)
(deftest cl-12-56-221 () (ash -1 40) #x-10000000000)
(deftest cl-12-56-222 () (ash -1 50) #x-4000000000000)
(deftest cl-12-56-223 () (ash -1 60) #x-1000000000000000)
(deftest cl-12-56-224 () (ash -1 70) #x-400000000000000000)
(deftest cl-12-56-225 () (ash -1 80) #x-100000000000000000000)
(deftest cl-12-56-226 () (ash -1 90) #x-40000000000000000000000)
(deftest cl-12-56-227 () (ash -1 100) #x-10000000000000000000000000)
(deftest cl-12-56-228 () (ash -1 110) #x-4000000000000000000000000000)
(deftest cl-12-56-229 () (ash -1 120) #x-1000000000000000000000000000000)
(deftest cl-12-56-230 () (ash -1 130) #x-400000000000000000000000000000000)
(deftest cl-12-56-231 () (ash -1 140) #x-100000000000000000000000000000000000)
(deftest cl-12-56-232 () (ash -1 150) #x-40000000000000000000000000000000000000)
(deftest cl-12-56-233 () (ash -1 160) #x-10000000000000000000000000000000000000000)
(deftest cl-12-56-234 () (ash -1 170) #x-4000000000000000000000000000000000000000000)
(deftest cl-12-56-235 () (ash -1 180) #x-1000000000000000000000000000000000000000000000)
(deftest cl-12-56-236 () (ash -1 190) #x-400000000000000000000000000000000000000000000000)
(deftest cl-12-56-237 () (ash -1 200) #x-100000000000000000000000000000000000000000000000000)

;;;; 12.2.74 float
(deftest cl-12-74-201 ()
  "most-positive-single-float"
  (integer-decode-float (float (ash #xffffff 104)))
  (values 16777215 104 1) )

(deftest cl-12-74-202 ()
  "most-negative-single-float"
  (integer-decode-float (float (ash #x-ffffff 104)))
  (values 16777215 104 -1) )


(deftest cl-12-74-203 ()
  "most-positive-double-float"
  (integer-decode-float (float (ash #x1fffffffffffff 971) 0d0))
  (values 9007199254740991 971 1) )

(deftest cl-12-74-204 ()
  "most-negative-double-float"
  (integer-decode-float (float (ash #x-1fffffffffffff 971) 0d0))
  (values 9007199254740991 971 -1) )

(deftest cl-12-74-205 ()
  (loop
    for k from (integer-length most-positive-fixnum) to 127
    for ix = (ash  1 k)
    for fx = (float ix)
    for iy = (ash -1 k)
    for fy = (float iy)
      unless (or (eql ix (- iy)) (eql fx (- fy))) collect ix )
  nil )
